Phylogenetic analysis based on identity and hive plot for species distribution
Phylogenetic analysis based on identity
Load generic libraries
source('configuration.r')Load plot specific libraries
library(ggtree)
library(HiveR)
library(magrittr)
library(phytools)
library(forcats)Merge data
df <- read.table('../tables/genome_info.dat', head=TRUE, stringsAsFactors = FALSE, comment.char = '!', sep='\t')
meta.illumina <- read.table('../metadata/illumina_metadata.txt', head=TRUE)[,-2]
meta.nanopore <- read.table('../metadata/nanopore.metadata.txt', head=TRUE, sep='\t', strip.white = TRUE)
meta.merged <- merge(meta.nanopore, meta.illumina,
by.x='Illumina_Library_ID',
by.y='Library')
meta.merged <- merge(df, meta.merged,
by='Nanopore_ID') %>%
select(Genome_ID, everything()) %>%
mutate(Sample_type=fct_drop(Sample_type))
colnames(meta.merged)[3] <- 'Species'
## fix names in metadata to be consistent with the manuscript
levels(meta.merged$Sample_type) <- str_replace_all(levels(meta.merged$Sample_type), c('handle-interior'='Handle'))
levels(meta.merged$Room_type) <- str_replace_all(levels(meta.merged$Room_type), c('cubicles'='wards', 'Non-cohort'='Standard'))
levels(meta.merged$Cubicle_room) <- str_replace_all(levels(meta.merged$Cubicle_room), c('Cubicle'='Ward'))
meta.merged %<>% filter(timept %in% c(1,2))
write.table(meta.merged, '../output_tables/merged_assembly_metadata.tsv', quote=F, row.names = F, col.names = T, sep='\t')Function to plot the tree with heatmap
## function to get cluster data:
get.clusters <- function(x){
dist.file <- paste0("../tables/", x, "_mummer_heatmap.dat")
dist.dat <- read.table(dist.file)
idx <- rownames(dist.dat) %in% (filter(meta.merged, Genome_quality=='HIGH_QUAL'))$Genome_ID | ##High quality genomes
str_detect(rownames(dist.dat), 'G|F') # use ['G|F'] to include the new data
dist.dat <- dist.dat[idx, idx]
## clustering
cluster.full <- hclust(as.dist(dist.dat), method='single')
clusters <- cutree(cluster.full, h=0.001)
## filter patient data
clusters <- clusters[str_detect(names(clusters), 's_')]
merged <- merge(data.frame(clusters), meta.merged, by.x=0, by.y=1) %>%
mutate(strain=paste0('s', clusters), input_distance_matrix=dist.file)
merged
}
## function to plot tree
plot.tree <- function(x, color, offset=0.01, title=NULL, scale_offset_x=0.005, scale_offset_y=0){
merged <- get.clusters(x)
tree.strains <- read.tree(paste0('../tables/trees/', x, ".parsnp.tree"))
tree.strains$tip.label %<>% str_replace_all(c(".trimmed.fasta"="", "nanopore.cons.cluster_"="s", ".ref"=""))
antibiotics <- select(merged, strain, Antibiotics) %>% group_by(strain, Antibiotics) %>%
count() %>% spread(Antibiotics,n,fill=0) %>%
select(-BHI) %>% data.frame(row.names = 'strain')
antibiotics[antibiotics > 0] <- 'D'
p <-
ggtree(midpoint.root(tree.strains), layout="fan", open.angle=45, lwd=1) +
geom_tippoint(size=3, shape=19, col=color) +
geom_tiplab2(size=5, offset=offset/3) +
geom_treescale(x=scale_offset_x, y=scale_offset_y, linesize=0.8, offset=0.1)
p <- gheatmap(p, offset=offset, antibiotics, color='black', colnames_offset_y = 0.3,##colnames_offset_x=10,
colnames_angle = 60, hjust =1, font.size=6.5) + scale_fill_manual(values=c('white', color)) +
theme(legend.position ='none', plot.title = element_text(size = 40, face = "bold.italic")) +
ggtitle(title)
return(p)
}Save merged strain table (used for generating parsnp trees)
d1 <- get.clusters('Elizabethkingia_anophelis')
d2 <- get.clusters('Staphylococcus_epidermidis')
d3 <- get.clusters('Staphylococcus_aureus')
d4 <- get.clusters('Acinetobacter_baumannii')
d5 <- get.clusters('Pseudomonas_aeruginosa')
d6 <- get.clusters('Enterococcus_faecium')
d7 <- get.clusters('Enterococcus_faecalis') %>% filter(Nanopore_ID != 'N182_BC10')
## N182_BC10 is removed due to low coverage comparing to the reference when constructing the tree
d8 <- get.clusters('Klebsiella_pneumoniae')
dat.all.species <- rbind(d1, d2, d3, d4, d5, d6, d7, d8)
write.table(dat.all.species,
'../output_tables/strain_cluster_summary.tsv', sep='\t', row.names = F, col.names = T, quote=F)Generate tree plots
colors <- pal_npg('nrc')(8)
g1 <- plot.tree('Elizabethkingia_anophelis', colors[1], 1, 'Elizabethkingia anophelis', 1)
g2 <- plot.tree('Staphylococcus_epidermidis', colors[2], 0.08, 'Staphylococcus epidermidis', 0.35)
g3 <- plot.tree('Staphylococcus_aureus', colors[3], 0.05, 'Staphylococcus aureus', 0.2)
g4 <- plot.tree('Acinetobacter_baumannii', colors[4], 0.2, 'Acinetobacter baumannii', scale_offset_x = 0.3)
g5 <- plot.tree('Pseudomonas_aeruginosa', colors[5], 0.2, 'Pseudomonas aeruginosa', scale_offset_x = 0.3)
g6 <- plot.tree('Enterococcus_faecium', colors[6], 0.9, 'Enterococcus faecium', scale_offset_x = 0.8)
g7 <- plot.tree('Enterococcus_faecalis', colors[7], 0.05, 'Enterococcus faecalis', scale_offset_x = 0.2)
g8 <- plot.tree('Klebsiella_pneumoniae', colors[8], 0.2, 'Klebsiella pneumoniae', scale_offset_x = 0.5)Main figure part (S. aureus)
g3
Supplementary figure part
s1 <- cowplot::plot_grid(g2, g4, g5, g6, g7, g8, nrow=1)
s1
Hive plot for species distribution
Generate edge data
rbind(d2, d3, d4, d5, d6, d7, d8) %>%
count(Species, clusters, Sample_type, Room_type, #bed_number,
timept, Sample_ID.y, Cubicle_room) %>%
mutate(clusters=sprintf("%02d", clusters)) %>%
distinct(Species, clusters, Sample_type, Cubicle_room, Room_type, timept) %>%
mutate(label1='Strain', label2='Site', label3='Room') %>%
unite(n1,c(label1, Species, clusters), sep='=', remove=F) %>%
unite(n2,c(label2, Sample_type), sep='=', remove=F) %>%
unite(n3,c(label3, Room_type, Cubicle_room), sep='=',remove=F) %>%
select(-label1, -label2, -label3) -> edge_data
## remove strains only occurred once at one place
edge_data <- filter(edge_data, n1%in%
(edge_data %>% group_by(n1) %>% count %>% filter(n>1))$n1)Fisher’s exact test for enrichment (multi-resitance vs. persistance)
test.dat <-
rbind(d2, d3, d4, d5, d6, d7, d8) %>%
group_by(Species, clusters, Sample_type, Room_type, bed_number,
timept, Sample_ID.y, Cubicle_room) %>%
summarise(n=sum(Antibiotics!='BHI')) %>%
group_by(Species, clusters) %>% mutate(resistance= max(n)) %>% ungroup %>%
count(Species, clusters, resistance, name='found')
test <- function(x){
c1 <- nrow(filter(x, resistance>2, found>1))
c2 <- nrow(filter(x, resistance>2, found<=1))
c3 <- nrow(filter(x, resistance<=2, found>1))
c4 <- nrow(x)
fisher.test(matrix(c(c1,c2,c3,c4), 2,2))$p.value
}
sp <- unique(test.dat$Species)
c(sapply(sp, function(x) test(filter(test.dat, Species==x))), All=test(test.dat))## Acinetobacter_baumannii Enterococcus_faecalis
## 1.129032e-01 1.414677e-04
## Enterococcus_faecium Klebsiella_pneumoniae
## 3.571429e-02 6.060606e-02
## Pseudomonas_aeruginosa Staphylococcus_aureus
## 1.250000e-01 3.652174e-02
## Staphylococcus_epidermidis All
## 3.650732e-05 4.693422e-13Fisher’s exact test for enrichment (time vs. space)
test.dat <-
rbind(d2, d3, d4, d5, d6, d7, d8) %>%
distinct(Species, clusters, Sample_type, Room_type, bed_number,
timept, Sample_ID.y, Cubicle_room) %>%
count(Species, clusters, timept) %>%
group_by(Species, clusters) %>%
summarise(time=length(timept), space=max(n))
test <- function(x){
c1 <- nrow(filter(x, time>1, space>1))
c2 <- nrow(filter(x, time>1, space<=1))
c3 <- nrow(filter(x, time<=1, space>1))
c4 <- nrow(x)
fisher.test(matrix(c(c1,c2,c3,c4), 2,2))$p.value
}
sp <- unique(test.dat$Species)
c(sapply(sp, function(x) test(filter(test.dat, Species==x))), All=test(test.dat))## Acinetobacter_baumannii Enterococcus_faecalis
## 8.547009e-03 6.837607e-03
## Enterococcus_faecium Klebsiella_pneumoniae
## 1.758242e-01 3.125000e-02
## Pseudomonas_aeruginosa Staphylococcus_aureus
## 1.000000e+00 8.079051e-02
## Staphylococcus_epidermidis All
## 9.263732e-04 3.415711e-11Hive plot function
hiveplot <- function(species, col, silent=FALSE){
edge_plot <- filter(edge_data ,Species==species)
strain_col <- col
rbind(data.frame(x1=edge_plot$n1, x2=edge_plot$n2, color=edge_plot$timept, stringsAsFactors = F) ,
data.frame(x1=edge_plot$n1, x2=edge_plot$n3, color=edge_plot$timept, stringsAsFactors = F)
) %>%
group_by(x1, x2, color) %>% count() %>%
select(x1, x2, weight=n, color) %>%
arrange(desc(x1,x2)) -> e
hive <- edge2HPD(data.frame(e[,1:3]))
hive$nodes$axis <- as.integer(as.factor(str_split_fixed(hive$nodes$lab, '=', 2)[,1]))
hive$nodes$tag <- str_split_fixed(hive$nodes$lab, '=', 3)[,1]
hive$nodes[hive$nodes$axis==1, ] <- arrange(hive$nodes[hive$nodes$axis==1, ], lab) ## sort the names on the room axis
## species color
hive$nodes$color[ hive$nodes$tag == 'Strain'] <- strain_col
## site color
colors <- sapply(c(pal_simpsons('springfield')(16)), adjustcolor, alpha.f=0.9)
colormap <- data.frame(site=levels((edge_data$Sample_type)), col=pal_npg('nrc')(10)[c(5,7,2,3,10,4,1)], row.names = 1, stringsAsFactors = F)
#colormap <- data.frame(site=levels(edge_data$Sample_type), col=colors[1:9], row.names = 1, stringsAsFactors = F)
site.id <- hive$nodes$tag=='Site'
hive$nodes$color[site.id] <- colormap[str_split_fixed(hive$nodes$lab, '=', 2)[site.id, 2], ]
## room color
colormap <-data.frame(room=unique(edge_data$Room_type), col=colors[c(13,15,16)], row.names = 1, stringsAsFactors = F)
room.id <- hive$nodes$tag=='Room'
hive$nodes$color[room.id] <- colormap[str_split_fixed(hive$nodes$lab[room.id], '=', 3)[,2], ]
hive$nodes$size=2
hive$edges$weight <- hive$edges$weight*3-1
hive$edges$color <- ifelse(e$color<2, '#ff990055','#66ccff55')
#hive$edges$color <- ifelse(e$color<2,'#66ccff77', '#ff330077')
tmp <- data.frame(node.lab=hive$nodes$lab, node.text=hive$nodes$lab, angle=0, radius=0, offset=0, hjust=1, vjust=0.5)
mutate(tmp, node.text=str_replace(node.text, 'Strain=.*=', 'Strain=s')) %>%
separate(col=node.text, into=c('lab','node.text'), '=', extra='merge') %>%
mutate(node.text=str_replace_all(node.text, '_', ' ')) %>%
mutate(node.text=str_replace_all(node.text, '=', ': ')) %>%
mutate(offset=ifelse(lab=='Room' | lab=='Site' , -0.05, -0.03)) %>%
select(-lab) %>%
write.table('tmp_hive.txt', sep=',', quote=T, row.names = F, col.names = T)
if(silent){return(hive)}
plotHive(hive, ch=0.2, method='ranknorm', bkgnd='white', anNodes = 'tmp_hive.txt',
anNode.gpar=gpar(cex=1.5))
}Main figure part (S. aureus)
hiveplot('Staphylococcus_aureus', colors[3])
aux <- function(){
vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y)
grid.newpage()
pushViewport(viewport(layout = grid.layout(1, 6)))
pushViewport(vplayout(1, 1)) # left plot
h <- hiveplot('Staphylococcus_epidermidis', colors[2], silent = TRUE)
plotHive(h, ch=0.2, method='ranknorm', bkgnd='white', anNodes = 'tmp_hive.txt', np=FALSE,anNode.gpar=gpar(cex=1.5))
popViewport(2)
pushViewport(vplayout(1, 2))
h <- hiveplot('Acinetobacter_baumannii', colors[4], silent=TRUE)
plotHive(h, ch=0.2, method='ranknorm', bkgnd='white', anNodes = 'tmp_hive.txt', np=FALSE,anNode.gpar=gpar(cex=1.5))
popViewport(2)
pushViewport(vplayout(1, 3))
h <- hiveplot('Pseudomonas_aeruginosa', colors[5], silent=TRUE) ## only one node -- cannot use 'ranknorm'
plotHive(h, ch=0.2, method='rank', bkgnd='white', anNodes = 'tmp_hive.txt', np=FALSE,anNode.gpar=gpar(cex=1.5))
popViewport(2)
pushViewport(vplayout(1, 4))
h <- hiveplot('Enterococcus_faecium', colors[6], silent=TRUE)
plotHive(h, ch=0.2, method='ranknorm', bkgnd='white', anNodes = 'tmp_hive.txt', np=FALSE,anNode.gpar=gpar(cex=1.5))
popViewport(2)
pushViewport(vplayout(1, 5))
h <- hiveplot('Enterococcus_faecalis', colors[7], silent=TRUE)
plotHive(h, ch=0.2, method='ranknorm', bkgnd='white', anNodes = 'tmp_hive.txt', np=FALSE,anNode.gpar=gpar(cex=1.5))
popViewport(2)
pushViewport(vplayout(1, 6))
h <- hiveplot('Klebsiella_pneumoniae', colors[8], silent=TRUE) ## only one node -- cannot use 'ranknorm'
plotHive(h, ch=0.2, method='rank', bkgnd='white', anNodes = 'tmp_hive.txt', np=FALSE,anNode.gpar=gpar(cex=1.5))
}
aux()
Save plots
ggsave('../plots/fig3d.tree_main.svg', g3, width=10, height=10)
svg('../plots/fig3d.hive_main.svg', width = 10, height = 10)
hiveplot('Staphylococcus_aureus', colors[3])
dev.off()## quartz_off_screen
## 2ggsave('../plots/sup10.tree_sup.svg', s1, width=54, height=9, limitsize = F)
svg('../plots/sup10.hive_sup.svg', width = 84, height = 14)
aux()
dev.off()## quartz_off_screen
## 2Session informaton
sessionInfo()## R version 3.5.1 (2018-07-02)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS 10.14.6
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] grid stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] gdtools_0.1.7 forcats_0.3.0 phytools_0.6-99 maps_3.3.0
## [5] ape_5.3 magrittr_1.5 HiveR_0.3.42 ggtree_1.99.1
## [9] ggsci_2.9 reshape2_1.4.3 stringr_1.4.0 tibble_2.1.3
## [13] tidyr_1.0.0 dplyr_0.8.3 gridExtra_2.3 ggplot2_3.2.1
##
## loaded via a namespace (and not attached):
## [1] jsonlite_1.6 gtools_3.8.1
## [3] shiny_1.2.0 assertthat_0.2.1
## [5] expm_0.999-4 rvcheck_0.1.3
## [7] animation_2.6 yaml_2.2.0
## [9] numDeriv_2016.8-1 pillar_1.4.2
## [11] backports_1.1.4 lattice_0.20-38
## [13] glue_1.3.1 quadprog_1.5-5
## [15] phangorn_2.5.5 digest_0.6.20
## [17] manipulateWidget_0.10.0 RColorBrewer_1.1-2
## [19] promises_1.0.1 colorspace_1.4-1
## [21] cowplot_0.9.3 htmltools_0.3.6
## [23] httpuv_1.4.5 Matrix_1.2-15
## [25] plyr_1.8.4 pkgconfig_2.0.2
## [27] purrr_0.3.2 xtable_1.8-3
## [29] tidytree_0.2.7 scales_1.0.0
## [31] webshot_0.5.1 svglite_1.2.1
## [33] jpeg_0.1-8 later_0.7.5
## [35] combinat_0.0-8 ellipsis_0.2.0.1
## [37] withr_2.1.2 lazyeval_0.2.2
## [39] mnormt_1.5-5 crayon_1.3.4
## [41] mime_0.6 evaluate_0.12
## [43] nlme_3.1-137 MASS_7.3-51.1
## [45] tools_3.5.1 lifecycle_0.1.0
## [47] munsell_0.5.0 plotrix_3.7-6
## [49] compiler_3.5.1 clusterGeneration_1.3.4
## [51] rlang_0.4.0 tkrgl_0.8
## [53] htmlwidgets_1.3 crosstalk_1.0.0
## [55] igraph_1.2.2 miniUI_0.1.1.1
## [57] labeling_0.3 tcltk_3.5.1
## [59] rmarkdown_1.10 gtable_0.3.0
## [61] R6_2.4.0 knitr_1.20
## [63] zeallot_0.1.0 fastmatch_1.1-0
## [65] rprojroot_1.3-2 treeio_1.9.2
## [67] stringi_1.4.3 parallel_3.5.1
## [69] Rcpp_1.0.2 vctrs_0.2.0
## [71] png_0.1-7 rgl_0.99.16
## [73] scatterplot3d_0.3-41 tidyselect_0.2.5
## [75] coda_0.19-2